home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / SPOOLER.M < prev    next >
Encoding:
Text File  |  1989-03-10  |  6.4 KB  |  193 lines
  1. MODULE Spooler;
  2. (*$Q-*)
  3.  
  4. (* ---------------------------------------------------------- *)
  5. (* Copyright (c) 1985, 1986, 1987.Modula-2 Software Ltd.  UK  *)
  6. (*                           and  TDI Software, Inc.      USA *)
  7. (* ---------------------------------------------------------- *)
  8.  
  9. (* Spooler desk accessory.
  10.  
  11.    Original Author : PLC, Modula-2 Software Ltd,. UK
  12.  
  13.    Version         : 0.00b  24-Apr-86  PLC, Modula-2 Software Ltd.
  14.                        Fixed Alloc bug.
  15.                      0.00a  13-Mar-86  PLC, Modula-2 Software Ltd.
  16.                        Original.
  17.  
  18. *)
  19.  
  20. (* Spooler information.
  21.  
  22.    This is a small spooler desk accessory to show how limited multitasking
  23.    can be accomplished under GEM and how a desk accessory can be programmed.
  24.    The 512 byte stack allocated by the runtime support is ample for this
  25.    accessory. After linking, rename SPOOLER.PRG to SPOOLER.ACC using the
  26.    file menu "Show Info" option. Copy SPOOLER.ACC to a boot disk and reboot
  27.    the system. The Spooler should install itself in the Desk menu.
  28. *)
  29.  
  30.  
  31. FROM SYSTEM IMPORT ADR, ADDRESS;
  32. FROM GEMEnv IMPORT SelectFile, InitGem, DeviceHandle, RC, ApplicationID;
  33. FROM AESMenus IMPORT RegisterAcc;
  34. FROM GEMGlobals IMPORT MButtonSet, MouseButton, GemChar, SpecialKeySet;
  35. FROM GrafBase IMPORT Rect, Pnt, Rectangle, Point;
  36. FROM AESEvents IMPORT MultiEvent, EventSet, RectEnterMode, Event,
  37.                 accOpen, MessageBuffer;
  38. FROM AESForms IMPORT FormAlert;
  39. FROM GEMDOS IMPORT Alloc, Free, Open, Close, Read, Seek, PrnOS, PrnOut,
  40.   beginning, end;
  41.  
  42. (*$Q+*)
  43.  
  44. CONST
  45.   MaxPrinterSpeed = 200;  (* 80 cps. Could handle higher rates *)
  46.  
  47. CONST
  48.   (* number of milliseconds to wait for next character output *)
  49.   SensePeriod = 1000 DIV MaxPrinterSpeed;
  50.  
  51. CONST
  52.   Title = "  Spooler";
  53.  
  54. VAR
  55.   applID: CARDINAL;  (* desk application ID *)
  56.   menuID: INTEGER;  (* menu ID *)
  57.   Msg: MessageBuffer;
  58.   handle: INTEGER;
  59.   events: EventSet;
  60.   i, place: CARDINAL;
  61.   path: ARRAY [0..39] OF CHAR;
  62.   file: ARRAY [0..19] OF CHAR;
  63.   printing: BOOLEAN;  (* TRUE if currently printfile a file *)
  64.   adr: ADDRESS;  (* base address of file memory buffer *)
  65.   prnadr: POINTER TO CHAR;
  66.   length: LONGINT;  (* length of file, and of memory block *)
  67.  
  68. PROCEDURE DoSpool(VAR x: ARRAY OF CHAR): BOOLEAN;
  69. VAR res: CARDINAL;
  70.   li: LONGINT; lc: LONGCARD;
  71. BEGIN
  72.   (* open file *)
  73.   Open(x,0,handle);
  74.   IF handle <= 0 THEN
  75.     FormAlert(1,"[2][File not found][ OK ]",res);
  76.     RETURN FALSE
  77.   END;
  78.  
  79.   (* get file length *)
  80.   Seek(0,handle,end,length);
  81.   Seek(0,handle,beginning,li);
  82.  
  83.   (* grab some memory for the file buffer *)
  84.   Alloc(length,adr);
  85.   IF adr = 0L THEN                                               (*0.00b*)
  86.     (* not enough memory... *)
  87.     IF Close(handle) THEN END;
  88.     FormAlert(1,"[1][Not enough memory][ OK ]",res);
  89.     RETURN FALSE
  90.   END;
  91.  
  92.   (* read file into buffer *)
  93.   lc := length;
  94.   Read(handle,lc,adr);
  95.   IF Close(handle) THEN END;
  96.  
  97.   (* take care of read errors *)
  98.   IF lc # LONGCARD (length) THEN
  99.     FormAlert(1,"[2][Read error][ OK ]",res);
  100.     RETURN FALSE
  101.   END;
  102.  
  103.   (* set print start address in memory, return "good spool request" *)
  104.   prnadr := adr;
  105.   RETURN TRUE
  106. END DoSpool;
  107.  
  108.  
  109. VAR ok: BOOLEAN; gem: DeviceHandle; titel: ARRAY [0..20] OF CHAR;
  110.     x: CARDINAL;
  111.     point: Point; mbset: MButtonSet; skset: SpecialKeySet; gemch: GemChar;
  112.     evset: EventSet;
  113.  
  114. BEGIN
  115.   (* initialise application & install desk accessory *)
  116.   InitGem (RC, gem, ok);
  117.   titel:= Title;
  118.   RegisterAcc (ADR (titel), applID, ok);
  119.  
  120.   printing := FALSE;
  121.   LOOP
  122.     (* set event flags according to print status. This stops the
  123.        accessory from soaking up processor time waiting for a tick
  124.        when it isn't printing. *)
  125.     IF printing THEN events := EventSet{message, timer};
  126.     ELSE events := EventSet{message}
  127.     END;
  128.     MultiEvent (events, 0, MButtonSet{}, MButtonSet{},
  129.                 lookForEntry, Rect (0,0,0,0),
  130.                 lookForEntry, Rect (0,0,0,0),
  131.                 Msg,
  132.                 SensePeriod,
  133.                 point, mbset, skset, gemch,
  134.                 x, evset);
  135.     IF message IN evset THEN
  136.       (* got a message *)
  137.       IF (Msg.msgType = accOpen) THEN
  138.         IF printing THEN
  139.           FormAlert(2,"[3][Already spooling][ STOP | OK ]",x) ;
  140.           IF x = 1 THEN (* STOP *)
  141.             printing := FALSE;
  142.             (* free memory allocated to file buffer *)
  143.             IF Free(adr) THEN END
  144.           END
  145.         ELSE
  146.           path := "A:\*.*";
  147.           file[0] := 0C;
  148.  
  149.           (* open up file selector *)
  150.           SelectFile (path,file,ok);
  151.  
  152.           IF ok THEN
  153.             (* OK and no error, strip off ambiguous file specification *)
  154.             i := 0;
  155.             place := 0;
  156.             WHILE path[i] # 0C DO
  157.               IF path[i] = "\" THEN place := i END;
  158.               INC(i)
  159.             END;
  160.  
  161.             (* put filename onto end of path to get full specification *)
  162.             i := 0;
  163.             WHILE file[i] # 0C DO
  164.               path[place] := file[i];
  165.               INC(place); INC(i)
  166.             END;
  167.             path[place]:= 0C;
  168.  
  169.             (* see if we can spool it *)
  170.             printing := DoSpool(path)
  171.           END
  172.         END
  173.       END
  174.     ELSIF timer IN evset THEN
  175.       (* timer event occured *)
  176.       IF PrnOS() THEN
  177.         (* printer waiting for character *)
  178.         IF LONGCARD(prnadr)-LONGCARD(adr) = LONGCARD (length) THEN
  179.           (* come to end of buffer, stop printing *)
  180.           printing := FALSE;
  181.           (* free memory allocated to file buffer *)
  182.           IF Free(adr) THEN END
  183.         ELSE
  184.           PrnOut(prnadr^);  (* print buffer character *)
  185.           INC(prnadr)       (* advance to next buffer position *)
  186.         END
  187.       END
  188.     END
  189.   END
  190. END Spooler.
  192. (* $00000EFD$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$000015AD$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4$FFF8CAF4Ç$0000146BT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$FFF6D7DC$0000059E$000015A1$0000146B$00001077$000014FF$FFF6D7DC$FFF6D7DC$00000F95$00000F76$00000F83$0000109F$000010B4$FFF6D7DC$0000109F$000005A0ÿÇü*)
  193.